home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-20 / morse2.zip / MORSE.PAS < prev    next >
Pascal/Delphi Source File  |  1991-02-27  |  10KB  |  360 lines
  1. Program Morse;
  2. {
  3.    02/26/90
  4.  
  5.    Morse Code Program. Submitted to public domain by
  6.    Jerry Adkins KB8YA/6    COMPUSERVE ID: 70455,112.
  7.    7770 Regents Rd. #226
  8.    San Diego, CA 92122
  9.  
  10.    This program makes use of direct array indexing, instead of using a
  11.    lookup table. This makes very high translation speeds possible.
  12.    You may experiment with the typed constants Hz and Pause for different
  13.    default tone and speed.
  14.  
  15.    The files CQ.TXT and QSO.TXT reflect a typical conversation you are
  16.    likely to hear on the novice bands.
  17.  
  18.    It was done as a one evening experiment. Enjoy.
  19. }
  20.  
  21. Uses
  22.    Crt;
  23.  
  24. Type
  25.    String6 = String[6];
  26.  
  27. Const
  28.    Esc   = #27;
  29.    Hz    : Integer = 800;
  30.    Pause : Integer = 200;
  31.    DONE  = FALSE;
  32.  
  33.  { The array MorseChar has indices corresponding to the ordinal
  34.      value of the chars normally used in the Morse alphabet. This
  35.      allows high speed translation without using lookup tables. }
  36.    MorseChar : Array[44..90] Of String6 =
  37.      ('--..--' { , },    '-...-'  { - },
  38.       '.-.-.-' { . },    '-..-.'  { / },
  39.       '-----'  { 0 },    '.----'  { 1 },
  40.       '..---'  { 2 },    '...--'  { 3 },
  41.       '....-'  { 4 },    '.....'  { 5 },
  42.       '-....'  { 6 },    '--...'  { 7 },
  43.       '---..'  { 8 },    '----.'  { 9 },
  44.       '','','','','',
  45.       '..--..' { ? }     ,'',
  46.       '.-'     { A },    '-...'   { B },
  47.       '-.-.'   { C },    '-..'    { D },
  48.       '.'      { E },    '..-.'   { F },
  49.       '--.'    { G },    '....'   { H },
  50.       '..'     { I },    '.---'   { J },
  51.       '-.-'    { K },    '.-..'   { L },
  52.       '--'     { M },    '-.'     { N },
  53.       '---'    { O },    '.--.'   { P },
  54.       '--.-'   { Q },    '.-.'    { R },
  55.       '...'    { S },    '-'      { T },
  56.       '..-'    { U },    '...-'   { V },
  57.       '.--'    { W },     '-..-'  { X },
  58.       '-.--'   { Y },     '--..'  { Z });
  59.  
  60.    LegalChars : Set Of Char = [#44..#57,#63,#65..#90];
  61.  
  62. Var
  63.    Cmd : Integer;
  64.  
  65. Procedure SoundOut(n:Byte);
  66. { ***********************************************************
  67.   Store MorseChar[n] in Element string. Scan through string
  68.   and sound speaker based on a dot or dash. Use set Frequency
  69.   in Hz and delay time in Pause.
  70.   ***********************************************************}
  71. Var
  72.    i : Byte;
  73.    Element : String6;
  74.  
  75. Begin
  76.    Element := MorseChar[n];
  77.    For i := 1 to Length(Element) Do
  78.    Begin
  79.       Case Element[i] Of
  80.          '-' : Begin
  81.                   Sound(Hz);
  82.                   Delay(Pause);
  83.                End;
  84.          '.' : Begin
  85.                   Sound(Hz);
  86.                   Delay(Pause Div 2);
  87.                End;
  88.       End; { Case }
  89.       NoSound;
  90.       Delay(Pause Div 3);
  91.    End; { i }
  92.    Delay(Pause);
  93. End; { SoundOut }
  94.  
  95. Procedure OutPutChar(Ch:Char);
  96. { ***********************************************************
  97.   Convert Ch to number and send result to Procedure SoundOut
  98.   ***********************************************************}
  99. Var
  100.    n : Byte;
  101.  
  102. Begin
  103.    If Ch <> Esc Then
  104.    Write(Ch);
  105.    If Ch = #32 Then
  106.    Delay(Pause); { Delay for space }
  107.    n := Ord(Ch);
  108.    If Not (Chr(n) In LegalChars) Then Exit; { Not morse char }
  109.    SoundOut(n);
  110. End; { OutPutChar }
  111.  
  112. Procedure MorseKey;
  113. { ***********************************************************
  114.   Input from keyboard and process keystrokes. Exit on Esc.
  115.   ***********************************************************}
  116. Var
  117.    Ch : Char;
  118.  
  119. Begin
  120.    ClrScr;
  121.    WriteLn('Start typing. Press ESC to exit.');
  122.    Repeat
  123.       Ch := ReadKey;
  124.       If Ch = #13 Then Writeln;
  125.       Ch := UpCase(Ch);
  126.       OutPutChar(Ch);
  127.    Until Ch = Esc;
  128. End; { MorseKey }
  129.  
  130. Procedure OutPutLine(Line:String; Var Abort:Boolean);
  131. { ***********************************************************
  132.   Read text line from a file and process each char for output.
  133.   ***********************************************************}
  134. Var
  135.    i : Byte;
  136.    Ch : Char;
  137.  
  138. Begin
  139.    For i := 1 to Length(Line) Do
  140.    Begin
  141.       If KeyPressed Then
  142.       Begin
  143.          Ch := ReadKey;
  144.          If Ch = Esc Then
  145.          Begin
  146.             Abort := True;
  147.             Exit;
  148.          End;
  149.       End;
  150.       Ch := UpCase(Line[i]);
  151.       OutPutChar(Ch);
  152.    End;
  153.    WriteLn;
  154. End; { OutPutLine }
  155.  
  156. Procedure MorseRead;
  157. { ***********************************************************
  158.   Open text file and send to speaker as morse code.
  159.   ***********************************************************}
  160. Var
  161.    TextFile : Text;
  162.    Line, FileName : String;
  163.    Err : Integer;
  164.    Ch  : Char;
  165.    Abort : Boolean;
  166.  
  167. Begin
  168.    Abort := False;
  169.    FileName := '';
  170.    ClrScr;
  171.    GoToXY(20,12);
  172.    Write('Filename: ');
  173.    ReadLn(FileName);
  174.    If FileName = '' Then Exit;
  175.    {$I-}
  176.    Assign(TextFile,FileName);
  177.    Reset(TextFile);
  178.    Err := IoResult;
  179.    {$I+}
  180.    If Err <> 0 Then
  181.    Begin
  182.       GoToXY(20,13);
  183.       Write(#7,FileName,' not found. Press ENTER. ');
  184.       ReadLn;
  185.       Exit;
  186.    End;
  187.    ClrScr;
  188.    WriteLn('Reading ',FileName,'. Press Esc to abort.');
  189.    While Not Eof(TextFile) Do
  190.    Begin
  191.       ReadLn(TextFile,Line);
  192.       OutputLine(Line,Abort);
  193.       If Abort Then
  194.       Begin
  195.          Close(TextFile);
  196.          Exit;
  197.       End;
  198.    End;
  199.    Close(TextFile);
  200. End; { MorseRead }
  201.  
  202. Procedure RandomCode;
  203. { ***********************************************************
  204.   Random code practice in sets of four chars.
  205.   ***********************************************************}
  206. Var
  207.    n, c : Byte;
  208.    Ch : Char;
  209.  
  210. Begin
  211.    n := 0;
  212.    Ch := #0;
  213.    Randomize;
  214.    ClrScr;
  215.    WriteLn('Random code practice. Press ESC to abort.');
  216.    Repeat
  217.       If KeyPressed Then Ch := ReadKey;
  218.       Repeat
  219.         c := Random(90);
  220.       Until Chr(c) In LegalChars; { Acceptable Morse Chars }
  221.       Write(Chr(c));
  222.       SoundOut(c);
  223.       Inc(n);
  224.       If n > 3 Then
  225.       Begin
  226.          Write(#32);
  227.          Delay(Pause);
  228.          n := 0;
  229.       End;
  230.    Until Ch = Esc;
  231. End; { RandomCode }
  232.  
  233. Procedure CodeTest;
  234. { ***********************************************************
  235.   Random code sent. User types char in response to sound.
  236.   ***********************************************************}
  237. Var
  238.    Ch : Char;
  239.    n  : Byte;
  240.    Ok : Boolean;
  241.    CharsTyped, CharsMissed, Score : Real;
  242.  
  243. Begin
  244.    CharsTyped  := 0;
  245.    CharsMissed := 0;
  246.    Randomize;
  247.    ClrScr;
  248.    WriteLn('Type your response after hearing the sound. Press ESC to exit.');
  249.    Repeat
  250.       Repeat
  251.          n := Random(90);
  252.       Until (n > 43) And (Chr(n) In LegalChars);
  253.       SoundOut(n);
  254.       Ch := UpCase(ReadKey);
  255.       Ok := Ch In LegalChars;
  256.       If Ok Then
  257.       CharsTyped := CharsTyped + 1;
  258.       If Ord(Ch) = n Then
  259.       TextColor(White) Else
  260.       If Ok Then
  261.        CharsMissed := CharsMissed + 1;
  262.       If Ok Then
  263.       Write(Ch);
  264.       If Ord(Ch) <> n Then
  265.       Begin
  266.          TextColor(Red);
  267.          Write('   ',Chr(n));
  268.       End;
  269.       WriteLn;
  270.    Until Ch = Esc;
  271.    Score := (CharsMissed/CharsTyped) * 100;
  272.    TextColor(White);
  273.    ClrScr;
  274.    GoToXY(1,12);
  275.    If (CharsTyped > 1) And (CharsMissed < 1) Then
  276.     Write('Congratulations!!! Your score is 100%') Else
  277.    Begin
  278.       Write('You missed ',CharsMissed:3:0,' Out of ');
  279.       Write(CharsTyped:4:0);
  280.       Write('. Your score is ',100-Score:3:1,'%');
  281.    End;
  282.    Write(' . Press ENTER. ');
  283.    ReadLn;
  284. End; { CodeTest }
  285.  
  286. Procedure Settings;
  287. { ***********************************************************
  288.   Get Frequency in Hz.
  289.   Get Pause time. Pause time is 1000th of a second.
  290.   ***********************************************************}
  291. Begin
  292.    ClrScr;
  293.    Repeat
  294.       GoToXY(20,12); Write('Frequency in HZ ',HZ,': ');
  295.       ReadLn(Hz);
  296.    Until Hz > 200;
  297.    Repeat
  298.       GoToXY(20,14); Write('Delay time between chars ',Pause,': ');
  299.       ReadLn(Pause);
  300.    Until Pause > 10;
  301. End; { Settings }
  302.  
  303. Function Menu:Integer;
  304. { ***********************************************************
  305.   Display menu and return with number selection.
  306.   ***********************************************************}
  307. Var
  308.    Choice : Integer;
  309.    Ch : Char;
  310.  
  311. Begin
  312.    Repeat
  313.       TextColor(White);
  314.       TextBackground(Black);
  315.       ClrScr;
  316.       GoToXY(20,7);
  317.       Write('MORSE CODE PROGRAM. RELEASED TO PUBLIC DOMAIN BY');
  318.       GoToXY(20,8);
  319.       Write('JERRY ADKINS KB8YA/6  COMPUSERVE ID: 70455,112');
  320.  
  321.       GoToXY(30,10); Write('1 - CODE PRACTICE');
  322.       GoToXY(30,12); Write('2 - READ TEXT FILE');
  323.       GoToXY(30,14); Write('3 - RANDOM CODE');
  324.       GoToXY(30,16); Write('4 - SET SPEED AND TONE');
  325.       GoToXY(30,18); Write('5 - CODE TEST');
  326.       GoToXY(30,20); Write('Press ESC to exit.');
  327.       Ch := ReadKey;
  328.       If Ch = #0 Then
  329.       Ch := ReadKey;
  330.       Case Ch Of
  331.          Esc :
  332.          Begin
  333.             Menu := 0;
  334.             Exit;
  335.          End;
  336.         '1'..'5' :
  337.         Begin
  338.            Menu := Ord(Ch)-48;
  339.            Exit;
  340.         End;
  341.      End; { Case }
  342.   Until DONE;
  343. End; { Menu }
  344.  
  345. Begin { Main Program }
  346. { ***********************************************************
  347.   Main part of program. Control branching and exit to DOS.
  348.   ***********************************************************}
  349.    Repeat
  350.       Cmd := Menu;
  351.       Case Cmd Of
  352.          1: MorseKey;
  353.          2: MorseRead;
  354.          3: RandomCode;
  355.          4: Settings;
  356.          5: CodeTest;
  357.       End; { Case }
  358.    Until Cmd = 0;
  359. End. { Morse }
  360.